home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok31 / environment / mpcompile.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  280 lines

  1. (* ********************************************************************** *)
  2. (*      Compilieren mit der Maus für beliebige Programmierumgebungen      *)
  3. (*                MPCompile  V3.0  ---  © 1989 by M.Peuckert              *)
  4. (* ********************************************************************** *)
  5. (*---------------------------------------------------------------------------
  6.    :Program.    MPCompile
  7.    :Version.    3.0
  8.    :Contants.   Compiling, linking, debugging, etc.
  9.    :History.    V2.0, Markus Peuckert, Simple
  10.    :History.    V3.0, Markus Peuckert, slightly improved version, Mar-89
  11.    :Author.     Markus Peuckert
  12.    :Address.    Schützenstr. 50, D-3550 Marburg, West-Germany,
  13.    :Copyright.  PD
  14.    :Language.   Modula-2
  15.    :Translator. M2Amiga V3.2d
  16. ---------------------------------------------------------------------------*)
  17.  
  18. MODULE MPCompile;
  19.  
  20. FROM SYSTEM     IMPORT  ADR,ADDRESS;
  21. FROM Arts       IMPORT  Assert;
  22. FROM Exec       IMPORT  WaitPort, GetMsg, ReplyMsg;
  23. FROM Intuition  IMPORT  GadgetPtr, IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
  24.                         CloseWindow, WindowFlags, WindowFlagSet, ScreenFlags,
  25.                         ScreenFlagSet,  ActivationFlags, ActivationFlagSet,
  26.                         WindowPtr, SetWindowTitles, RefreshGadgets,
  27.                         ActivateGadget, RemoveGList, AddGList, SizeWindow,
  28.                         MoveWindow;
  29. FROM Graphics   IMPORT  SetRast;
  30. FROM Dos        IMPORT  Execute;
  31. FROM FileSystem IMPORT  File;
  32. FROM Strings    IMPORT  Occurs, Insert, Delete, Copy, Length, first, last;
  33. FROM DosSupport IMPORT  OpenCon, CloseCon, CD;
  34. FROM IntuiSup   IMPORT  CreateWindow, IDCMPOn, IDCMPOff, ActivWindow;
  35. FROM MPGad      IMPORT  MaxChar, DrawText,
  36.                         compgad, linkgad, debuggad,rungad, exgad, edgad,
  37.                         popgad, loadgad, savegad, compilgad, linkergad,
  38.                         loadergad, prggad, editgad, CompilBuf, LinkerBuf,
  39.                         LoaderBuf, PrgBuf, EditBuf, CompGad, LinkGad, DebugGad,
  40.                         RunGad, ExGad, EdGad, PrgGad, PopGad, LoadGad;
  41. FROM MPWin      IMPORT  WinLEFT, WinTOP, WinHEIGHT, WinWIDTH, DWidth, DHeight,
  42.                         winTitle, win, win2, ConPtr, rp, rp2, fh;
  43. FROM MPDat      IMPORT  OpenConfig, CloseConfig, GetConfigParams,
  44.                         SetConfigParams;
  45.  
  46.  
  47. VAR Datei               : File;
  48.     PrgDir, FileName    : ARRAY [0..MaxChar] OF CHAR;
  49.     ConTit              : ARRAY [0..79] OF CHAR;
  50.     gadPos, realPos     : INTEGER;
  51.     FixLeft, FixTop     : INTEGER;
  52.  
  53.  
  54. (* Liest s:Compi.config aus, wenn besteht, sonst wird neu eingerichtet *)
  55. PROCEDURE LoadConfig;
  56. BEGIN
  57.         OpenConfig (Datei, FALSE);
  58.                 GetConfigParams (Datei, CompilBuf);
  59.                 GetConfigParams (Datei, LinkerBuf);
  60.                 GetConfigParams (Datei, LoaderBuf);
  61.                 GetConfigParams (Datei, EditBuf);
  62.         CloseConfig (Datei);
  63.         RefreshGadgets (ADR(LoadGad), win2, NIL)
  64. END LoadConfig;
  65.  
  66. (* Speichert Angaben des Eingabefensters in s:Compi.config *)
  67. PROCEDURE SaveConfig;
  68. BEGIN
  69.         OpenConfig (Datei, TRUE);
  70.                  SetConfigParams (Datei, CompilBuf);
  71.                  SetConfigParams (Datei, LinkerBuf);
  72.                  SetConfigParams (Datei, LoaderBuf);
  73.                  SetConfigParams (Datei, EditBuf);
  74.         CloseConfig (Datei);
  75. END SaveConfig;
  76.  
  77. (* Ermittelt letztes Vorkommen von token(=CHAR) in Str *)
  78. PROCEDURE LastPos (Str : ARRAY OF CHAR; token : CHAR; start : INTEGER) : INTEGER;
  79. VAR i, len : INTEGER;
  80. BEGIN
  81.  len := Length (Str);
  82.  FOR i:=len TO start BY -1 DO
  83.   IF (Str[i] = token) THEN
  84.    RETURN i
  85.   END
  86.  END;
  87.  RETURN -1
  88. END LastPos;
  89.  
  90. (* Holt Laufwerksbezeichnung und Dateiname aus Eingabestring *)
  91. PROCEDURE Extract (File : ARRAY OF CHAR; VAR dir, prefix : ARRAY OF CHAR);
  92. VAR dirpos, prepos, subpos, len : INTEGER;
  93.     ok                          : BOOLEAN;
  94. BEGIN
  95.  len    := Length (File);
  96.  dirpos := Occurs (File, first, ":", FALSE);
  97.  subpos := LastPos (File, "/", first);
  98.  prepos := Occurs (File, first, ".", FALSE);
  99.  
  100.  IF (subpos # last) THEN
  101.   Copy (dir, File, first, subpos+1);
  102.   ok := CD (dir);
  103.   IF (prepos # last) THEN   Copy (prefix, File, subpos+1, prepos-subpos-1)
  104.   ELSE   Copy (prefix, File, subpos+1, len-subpos-1)  END
  105.  ELSIF (subpos = last) THEN
  106.   IF (dirpos # last) THEN
  107.    Copy (dir, File, first, dirpos+1);
  108.    ok := CD (dir);
  109.    IF (prepos # last) THEN  Copy (prefix, File, dirpos+1, prepos-dirpos-1)
  110.    ELSE Copy (prefix, File, dirpos+1, len-dirpos-1)  END
  111.   ELSIF (dirpos = last) THEN
  112.    IF (prepos # last) THEN  Copy (prefix, File, first, prepos)
  113.    ELSE Copy (prefix, File, first, len)  END
  114.   END
  115.  END
  116. END Extract;
  117.  
  118. (* Führt übergebenen String als CLI-Kommando aus *)
  119. PROCEDURE Exec (Prog : ARRAY OF CHAR);
  120. VAR done        : INTEGER;
  121. BEGIN
  122.  done := Execute (ADR(Prog), NIL, fh);
  123. END Exec;
  124.  
  125. (* Setzt Filenamen in Compileraufruf anstelle des Platzhalters ein *)
  126. PROCEDURE Prepare (Envir, Prog : ARRAY OF CHAR);
  127. VAR pos : INTEGER;
  128. BEGIN
  129.  IF (Prog[0] = 0C) THEN RETURN END;
  130.  pos := Occurs (Envir, first, "#", FALSE);
  131.  Delete (Envir, pos, 1);
  132.  Insert (Envir, pos, Prog);
  133.  IDCMPOff (win);
  134.  Exec (Envir);
  135.  IDCMPOn (win, IDCMPFlagSet{closeWindow, gadgetUp, menuPick})
  136. END Prepare;
  137.  
  138. (* Compilieren, Linken und ausführen *)
  139. PROCEDURE RunAll (Comp, Link, Prog, Name : ARRAY OF CHAR);
  140. BEGIN
  141.  Prepare (Comp, Prog);
  142.  Prepare (Link, Name);
  143.  Exec (Name);
  144. END RunAll;
  145.  
  146. (* Setzt Titel des Ausgabefensters *)
  147. PROCEDURE SetConTitle (Merge : ARRAY OF CHAR);
  148. VAR pos : INTEGER;
  149. BEGIN
  150.  ConTit := " MPCompile V3.0 --- Output  :               ";
  151.  pos := Occurs (ConTit, first, ":", FALSE);
  152.  Insert (ConTit, pos+2, Merge);
  153.  Insert (ConTit, Length (ConTit), "                                             ");
  154.  SetWindowTitles (ConPtr, ADR(ConTit), NIL)
  155. END SetConTitle;
  156.  
  157. (* Öffnet Eingabefenster *)
  158. PROCEDURE OpenPop;
  159. VAR ok          : BOOLEAN;
  160. BEGIN
  161.   win2 := CreateWindow (WinLEFT, WinTOP+WinHEIGHT+1, WinWIDTH, 115,
  162.               IDCMPFlagSet{closeWindow, gadgetUp, activeWindow},
  163.               WindowFlagSet{windowDrag, windowDepth, windowClose, windowActive,
  164.               gimmeZeroZero, activate}, ADR(LoadGad), NIL,
  165.               ADR("        MPCompile --- PopWindow Preferences         "),
  166.               ScreenFlagSet{wbenchScreen});
  167.  Assert(win2#NIL,ADR("Kann Fenster nicht öffnen"));
  168.  rp2:=win2^.rPort;
  169.  DrawText (rp2);
  170.  IF (CompilBuf[0] = 0C) THEN LoadConfig END;
  171.  ok := ActivateGadget (ADR(PrgGad), win2, NIL);
  172. END OpenPop;
  173.  
  174. (* Fragt Gadgets des Einganfensters ab *)
  175. PROCEDURE GetPopWindow;
  176. VAR Msg2        : IntuiMessagePtr;
  177.     class2      : IDCMPFlagSet;
  178.     adr2        : GadgetPtr;
  179. BEGIN
  180.  OpenPop;
  181.  LOOP
  182.   WaitPort (win2^.userPort);
  183.   Msg2 := GetMsg (win2^.userPort);
  184.   WHILE Msg2#NIL DO
  185.    class2 := Msg2^.class; adr2 := Msg2^.iAddress;
  186.    ReplyMsg (Msg2);
  187.    IF (closeWindow IN class2) THEN EXIT END;
  188.    IF (gadgetUp IN class2) THEN
  189.     CASE adr2^.gadgetID OF
  190.      loadgad    : LoadConfig                                            |
  191.      savegad    : SaveConfig                                            |
  192.      prggad     : Extract (PrgBuf, PrgDir, FileName)                    |
  193.     ELSE
  194.     END (* case *)
  195.    END; (* if *)
  196.    Msg2 := GetMsg (win2^.userPort)
  197.   END (* while *)
  198.  END; (* loop *)
  199.  IF win2#NIL THEN CloseWindow (win2); win2:=NIL END;
  200.  SetConTitle (PrgBuf)
  201. END GetPopWindow;
  202.  
  203. (* Verkleinert das Steuerfenster *)
  204. PROCEDURE MinWin;
  205. VAR dXMov, dYMov : INTEGER;
  206. BEGIN
  207.  IF fh#NIL THEN   CloseCon (fh); fh := NIL   END;
  208.  FixLeft := win^.leftEdge; FixTop := win^.topEdge;
  209.  gadPos := RemoveGList (win, ADR(CompGad), -1);
  210.  SetRast (rp, 0);
  211.  SizeWindow (win, -DWidth, -DHeight);
  212.  dXMov := 420 - win^.leftEdge;  dYMov := 15 - win^.topEdge;
  213.  MoveWindow (win, dXMov, dYMov);
  214.  SetWindowTitles (win, ADR("MPCompile"), NIL)
  215. END MinWin;
  216.  
  217. (* Vergrößert das Steuerfenster *)
  218. PROCEDURE MaxWin;
  219. VAR dXMov, dYMov : INTEGER;
  220. BEGIN
  221.  fh := OpenCon ("CON:50/53/500/80/     MPCompile  ---  Output   :                        ");
  222.  ConPtr := ActivWindow ();
  223.  SetConTitle (PrgBuf);
  224.  dXMov := FixLeft - win^.leftEdge; dYMov := FixTop - win^.topEdge;
  225.  MoveWindow (win, dXMov, dYMov);
  226.  SizeWindow (win, DWidth, DHeight);
  227.  SetWindowTitles (win, ADR(winTitle), NIL);
  228.  realPos := AddGList (win, ADR(CompGad), gadPos, -1, NIL);
  229.  RefreshGadgets (ADR(CompGad), win, NIL)
  230. END MaxWin;
  231.  
  232. (* Holt Messages des Steuerfensters *)
  233. PROCEDURE GetIntuiMsg;
  234. VAR Msg         : IntuiMessagePtr;
  235.     class       : IDCMPFlagSet;
  236.     adr         : GadgetPtr;
  237.     toggle      : INTEGER;
  238. BEGIN
  239.  toggle:=1;
  240.  LOOP
  241.   WaitPort (win^.userPort);
  242.   Msg := GetMsg (win^.userPort);
  243.   WHILE Msg#NIL DO
  244.    class := Msg^.class; adr := Msg^.iAddress;
  245.    ReplyMsg (Msg);
  246.    IF (closeWindow IN class) THEN EXIT END;
  247.    IF (menuPick IN class) THEN
  248.     toggle:=1-toggle;
  249.     IF (toggle = 0) THEN  MinWin  ELSE  MaxWin  END
  250.    END;
  251.    IF (gadgetUp IN class) THEN
  252.     CASE adr^.gadgetID OF
  253.      compgad    : Prepare (CompilBuf, PrgBuf)                           |
  254.      linkgad    : Prepare (LinkerBuf, FileName)                         |
  255.      debuggad   : Prepare (LoaderBuf, FileName)                         |
  256.      rungad     : RunAll (CompilBuf, LinkerBuf, PrgBuf, FileName)       |
  257.      exgad      : Exec (FileName)                                       |
  258.      edgad      : IF (PrgBuf[0]=0C) THEN Prepare (EditBuf, " ")
  259.                   ELSE  Prepare (EditBuf, PrgBuf)  END                  |
  260.      popgad     : GetPopWindow                                          |
  261.     ELSE
  262.     END (* case *)
  263.    END; (* if *)
  264.    Msg := GetMsg (win^.userPort)
  265.   END (* while *)
  266.  END (* loop *)
  267. END GetIntuiMsg;
  268.  
  269.  
  270. VAR i : CARDINAL;
  271. BEGIN
  272.  
  273.  FOR i:=0 TO MaxChar DO  PrgDir[i] := 0C; FileName[i] := 0C  END;
  274.  
  275.  GetPopWindow;
  276.  
  277.  GetIntuiMsg;
  278.  
  279. END MPCompile.Mod
  280.